home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / ENTRY.SWG / 0013_Small Input Routines.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  10KB  |  356 lines
  1. Unit InputUn;
  2.  
  3. { This is a small unit with crash proof user input routines and some
  4.   string formating functions. Compile the DemoInput program for more
  5.   information on how to use these functions.
  6.  
  7.    Robert Mashlan [71160,3067]  3/11/89 }
  8.  
  9. Interface
  10.  
  11. Uses Crt;
  12.  
  13. const
  14.    DefaultSet = [' '..'}'];
  15.  
  16. Var
  17.    InverseOn    : boolean;
  18.    UpcaseOn     : boolean;
  19.    ValidCharSet : set of char;
  20.  
  21. Procedure Inverse;
  22. Procedure UnderLine;
  23. Procedure Normal;
  24. Procedure Goback;
  25. Function ReadString( Prompt : string; Width : byte; var Escape : boolean ) : string;
  26. Function ReadNum( Prompt : real; Width : byte; var Escape : boolean ) : real;
  27. Function ReadInt( Prompt : longint; Width : byte; var Escape : boolean ) : longint;
  28. Function Left( AnyString : string; Width : byte ) : string;
  29. Function Center( AnyString : string; Width : byte ) : string;
  30.  
  31. Implementation
  32.  
  33. const
  34.    esc = #27;
  35.  
  36. Procedure Inverse;
  37. begin
  38.    textbackground(white);
  39.    textcolor(black);
  40. end;
  41.  
  42. Procedure UnderLine;
  43. begin
  44.    textbackground(white);
  45.    textcolor(blue);
  46. end;
  47.  
  48. Procedure Normal;
  49. begin
  50.    textbackground(black);
  51.    textcolor(white);
  52. end;
  53.  
  54.  
  55. Procedure Goback;
  56. begin
  57.    GotoXY(WhereX,WhereY-1);
  58.    ClrEol;
  59. end;
  60.  
  61. Function Left( AnyString : string; Width : byte ) : string;
  62. var
  63.    len  : byte absolute AnyString;
  64.    loop : byte;
  65. begin
  66.    while length( AnyString ) < Width do
  67.       AnyString:=AnyString+' ';
  68.    len:=Width;      { truncate AnyString if Needed }
  69.    Left:=AnyString;
  70. end;
  71.  
  72. Function Center( AnyString : string; Width : byte ) : string;
  73. begin
  74.    repeat
  75.       if length( AnyString ) < Width
  76.          then AnyString:=AnyString+' ';
  77.       if length( AnyString ) < Width
  78.          then AnyString:=' '+AnyString;
  79.    until length( AnyString ) >= Width;
  80.    Center:=AnyString;
  81. end;
  82.  
  83.  
  84. Function ReadString( Prompt : string; Width : byte; var Escape : boolean ) : string;
  85. var
  86.    NewString    : string;
  87.    InKey,InKey2 : char;
  88.    Start        : byte;
  89.    index        : integer;
  90.    InsertMode   : boolean;
  91.  
  92.    Procedure Display;
  93.    begin
  94.       GotoXY(Start,WhereY);
  95.       if InverseOn
  96.          then Inverse;
  97.       write(left(NewString,Width));
  98.       if InverseOn
  99.          then Normal;
  100.       GotoXY(Start+index,WhereY);
  101.    end;
  102.  
  103.    Procedure StripSpaces( var AnyString : string );
  104.    { decrease length of AnyString until a character until a char other than a space is found }
  105.    begin
  106.       while AnyString[ ord(AnyString[0]) ]=' ' do
  107.          dec(AnyString[0]);
  108.    end; { Procedure }
  109.  
  110.  
  111.  
  112. begin
  113.    InsertMode:=false;
  114.    Start:=WhereX;
  115.    index:=0;
  116.    NewString:=Prompt;
  117.    Display;
  118.    index:=1;
  119.    if UpCaseOn
  120.       then Inkey:=UpCase(ReadKey)
  121.       else InKey:=ReadKey;
  122.    if InKey=#0
  123.       then begin
  124.          InKey2:=ReadKey;
  125.          if InKey2 in [#77,#82]
  126.             then NewString:=Prompt
  127.             else NewString:='';
  128.          if Inkey2=#82
  129.             then begin
  130.                InsertMode:=true;
  131.                index:=0;
  132.             end;
  133.       end { then }
  134.       else if InKey in ValidCharSet
  135.          then NewString:=InKey
  136.          else begin
  137.             NewString:='';
  138.             index:=0;
  139.          end;
  140.    if InKey=esc
  141.       then begin
  142.          ReadString:=Prompt;
  143.          Escape:=true;
  144.          ValidCharSet:=defaultSet;
  145.          exit;
  146.       end;
  147.    if InKey=#13
  148.       then begin
  149.          Escape:=false;
  150.          ReadString:=Prompt;
  151.          ValidCharSet:=DefaultSet;
  152.          exit;
  153.       end;
  154.    Display;
  155.    repeat
  156.      if UpCaseOn
  157.         then Inkey:=Upcase(readkey)
  158.         else InKey:=ReadKey;
  159.      if (InKey in ValidCharSet)
  160.        then begin
  161.            if not InsertMode
  162.               then Delete(NewString,index+1,1);
  163.            insert(InKey,NewString,index+1);
  164.            if index<> Width then inc(index)
  165.         end;
  166.      if (length(NewString)<>0) and (InKey=#8)  { backspace }
  167.         then begin
  168.            Delete(NewString,index,1);
  169.            if index<>0
  170.               then dec(index);
  171.         end;
  172.      if InKey=#0
  173.         then begin
  174.            InKey:=ReadKey;
  175.            case InKey of
  176.               #77 : if (index<>length(NewString)) and (' ' in ValidCharSet)
  177.                      then inc(index)
  178.                      else if (index+1<>Width) and (' ' in ValidCharSet)
  179.                         then begin
  180.                            NewString:=NewString+' ';
  181.                            inc(index);
  182.                         end;
  183.               #75 : if index<>0
  184.                        then if length(NewString)+1<>index
  185.                           then dec(index)
  186.                           else if NewString[index]=' '
  187.                              then begin
  188.                                 NewString[0]:=succ(NewString[0]);
  189.                                 dec(index);
  190.                              end
  191.                              else dec(index);
  192.               #83 : if length(NewString)>0 then Delete(NewString,index+1,1);
  193.               #82 : if InsertMode
  194.                        then InsertMode:=false
  195.                        else InsertMode:=true;
  196.            end; { case }
  197.         end; { then }
  198.      if Length(NewString)>width then dec( NewString[0] );
  199.      if index >= width then dec(index);
  200.      Display;
  201.    until (InKey=#13) or (InKey=esc);
  202.    ValidCharSet:=DefaultSet;
  203.    if not ( (InKey=esc) or (length(NewString)=0))
  204.       then begin
  205.          StripSpaces(NewString);
  206.          ReadString:=NewString
  207.       end
  208.       else ReadString:=Prompt;
  209.    if InKey=esc
  210.       then Escape:=true
  211.       else Escape:=false;
  212.  
  213. end; { Procedure }
  214.  
  215. Function ReadNum( Prompt : real; Width : byte; var Escape : boolean ) : real;
  216. var
  217.    NewString : string;
  218.    code      : integer;
  219.    OldNum    : real;
  220.    Start     : byte;
  221. begin
  222.    OldNum:=Prompt;
  223.    Start:=WhereX;
  224.    repeat
  225.       GotoXY(Start,WhereY);
  226.       str( Prompt:0:2, NewString );
  227.       ValidCharSet:=['0'..'9','.','-',' '];
  228.       NewString:=ReadString( NewString, Width, Escape );
  229.       val(NewString,Prompt,code);
  230.    until Escape or (code=0);
  231.    if Escape or (code<>0)
  232.       then ReadNum:=OldNum
  233.       else ReadNum:=Prompt;
  234. end;
  235.  
  236. Function ReadInt( Prompt : longint; Width : byte; var Escape : boolean ) : longint;
  237. var
  238.    NewString : string;
  239.    code      : integer;
  240.    OldNum    : longint;
  241.    Start     : byte;
  242. begin
  243.    OldNum:=Prompt;
  244.    Start:=WhereX;
  245.    repeat
  246.       GotoXY(Start,WhereY);
  247.       str( Prompt, NewString );
  248.       ValidCharSet:=['0'..'9','-',' '];
  249.       NewString:=ReadString( NewString, Width, Escape );
  250.       val(NewString,Prompt,code);
  251.    until Escape or (code=0);
  252.    if Escape
  253.       then ReadInt:=OldNum
  254.       else ReadInt:=Prompt;
  255. end;
  256.  
  257. begin
  258.    InverseOn:=true;
  259.    UpcaseOn:=false;
  260.    ValidCharSet:=DefaultSet;
  261. end.
  262.  
  263. { -----------------------------   DEMO PROGRAM ----------------------- }
  264. Program DemoInputUnit;
  265.  
  266. Uses
  267.    Crt, InputUn;
  268.  
  269. var
  270.    InKey     : char;
  271.    AnyString : string;
  272.    AnyInt    : longint;
  273.    AnyNum    : real;
  274.    Escape    : boolean;
  275.  
  276. begin
  277.    ClrScr;
  278.    writeln;
  279.    Inverse;
  280.    writeln(' Text in Inverse mode ');
  281.    writeln;
  282.    Underline;
  283.    writeln(' Text in Underline mode ( if using a monochrome monitor)');
  284.    writeln;
  285.    normal;
  286.    writeln(' Back to normal ');
  287.    writeln;
  288.    writeln(' The GoBack procedure is used...(press any key)................ ');
  289.    Inkey:=readkey;
  290.    goback;
  291.    writeln(' To erase a line and write a new one  (press any key) ');
  292.    InKey:=readkey;
  293.    ClrScr;
  294.    writeln(' The ReadString function takes 3 parameters');
  295.    writeln(' Function ReadString( Prompt : string; width : byte; var Escape : boolean )');
  296.    writeln('                                                                    : string;');
  297.    writeln(' Prompt is the string that is first put into the edit field.');
  298.    writeln(' This is the string that the function returns if the function is exited with');
  299.    writeln(' an Esc at any time, or a return while it is there.');
  300.    writeln(' This prompt may be edited if the right arrow or the insert key is pressed');
  301.    writeln(' on the first input, otherwise the prompt will disappear.  The return key ');
  302.    writeln(' will input all the visible characters in the field and exit the function.');
  303.    writeln(' The Del, left and right arrow keys work as does the backspace.');
  304.    writeln(' The Ins key toggles the insert mode where new characters are inserted ');
  305.    writeln(' instead of written over.  It is initially off.');
  306.    writeln(' Esc will also exit the function, return the prompt as the result and set ');
  307.    writeln(' the Escape parameter to true (otherwise set to false with a return');
  308.    writeln(' the width parameter sets the maximum length of the string');
  309.    writeln(' This field is highlighted in Inverse. It may be turned off by setting the');
  310.    writeln(' InverseOn to true. Another Global varible that affects this function is');
  311.    writeln(' ValidCharSet which is initially set to the set of all printable characters.');
  312.    writeln(' You can change it before calling this function, and is reset to the ');
  313.    writeln(' DefaultSet const after calling it.  The InverseOn varible will convert');
  314.    writeln(' all letters to uppercase if set to true. It is initially set to false');
  315.    writeln;
  316.    repeat
  317.       write('Input a string->');
  318.       AnyString:=ReadString('This is your prompt',20,escape);
  319.       writeln;
  320.       goback;
  321.       if escape
  322.          then write(' Escape Exit  ');
  323.       writeln('Your string is ''',AnyString,'''');
  324.       inkey:=readkey;
  325.       goback;
  326.       write('Input an integer ( ReadInt )->');
  327.       AnyInt:=ReadInt(123,5,Escape);
  328.       writeln;
  329.       goback;
  330.       if escape
  331.          then write(' Escape Exit  ');
  332.       writeln('Your integer is ',AnyInt);
  333.       if escape then exit;
  334.       inkey:=readkey;
  335.       goback;
  336.       write('Input a real number ( ReadNum )->');
  337.       AnyNum:=ReadNum(1.23,8,escape);
  338.       writeln;
  339.       goback;
  340.       if escape
  341.          then write(' Escape Exit  ');
  342.       writeln('Your Number is ',AnyNum:0:5);
  343.       if escape then exit;
  344.       if not escape
  345.          then begin
  346.             Inkey:=readkey;
  347.             goback;
  348.          end;
  349.    until escape;
  350. end.
  351.  
  352.  
  353.  
  354.  
  355.  
  356.